;; file     : dsdemo.scm
;; created  : June 15, 1995
;; author   : GWCelniker
;; copyright: Advanced Geometry Concepts, All Rights Reserved (c) 1995
;; synposis : Sequence of Scheme code to generate a simple deformable
;;            modeling sequence on a spline surface

;; defines an abreviated language for deformable surface editing
;; sets up some simple test cases for demo purposes
;; all the functions in this file duplicate the functions
;; provided by the scheme extensions and are purely optional
;; and are provided only for the convenience or experimentation.


;; DEMO FUNCTIONS - use these functions to start cases and then
;                   experiment with the below commands
; pinned-square . n m = An nxm control-pt square (default n=6)
;                       with center and corner pt-cstrns.
;                       Try tracking the pt-cstrns.
; hinged-square . n m = An nxm control-pt square (default n=6)
;                       with centered pt-cstrn and 4 edge crv-cstrns.
;                       Try tracking the ctr pt constraint.
; hung-square . n m   = An nxm control-pt square (default n=6)
;                       with centered pt-cstrn and 4 edge crv-loads.
;                       Try tracking the ctr pt constraint.
;                       Try changing ds-cc1, ds-cc2, ds-cc3, ds-cc4 with
;                       (hung-gain gain)
; gravity-square . n m= An nxm control-pt square (default n=6)
;                       a center-pt cstrn and vector-load.
;                       Try tracking the vector load.
; attractor-square . n m= An nxm control-pt square (default n=6)
;                       with centered pt-cstrn and attractor
;                       load. Try tracking the attractor load

; normal-square . n m= An nxm control-pt square (default n=6)
;                       with center and corner position-tangent pt-cstrns.
;                       Try tracking the central tangent constraint
; folding-square . n m= An nxm control-pt square (default n=6) using
;                       inhomgeneous material properties and default
;                       shape to show folding caused by a tracked
;                       pt-cstrn.
; corner-00 . n m     = An nxm control-pt square (default n=6) with
;                       internal linear crv-cstrn. Try tracking the pt-cstrn.
; par-00 . n m        = An nxm control-pt square (default n=6) with
;                       parabolic crv-cstrn. Try tracking the pt-cstrn.
; circ1-cstrn . n m   = An nxm control-pt square (default n=6)
;                       with a centered circle crv-cstrn and a
;                       pt-cstrn.  Try tracking the pt-cstrn.
; circ2-cstrn . n m   = An nxm control-pt square (default n=6)
;                       with an off-centered circle crv-cstrn and a
;                       pt-cstrn.  Try tracking the pt-cstrn. Try
;                       tracking with dynamic effects (dyn .1 100 1).
; circ3-cstrn. n m    = Adds circ cstrn after deforming the surface
;                       by tracking pinned-square.  Try
;                       tracking with dynamic effects (dyn .1 100 1)
; circ1-load . n m    = An nxm control-pt square (default n=6)
;                       with a centered circle crv-load and a pt-cstrn.
;                       Try tracking the pt-cstrn. Try varying the
;                       load gain with (gain ds-cc1 new_gain)
; circ2-load . n m    = An nxm control-pt square (default n=6) with
;                       an off-centered circle crv-load and a pt-cstrn.
;                       Try tracking the pt-cstrn. Try varying
;                       the load gain with (gain ds-cc1 new_gain)
; hinged-circ . n m   = An nxm control-pt square (default n=11) with
;                       a centered circle crv-load, a distributed
;                       pressure (ds-cc2) and  4 edge crv-cstrns. Try
;                       changing pressure gain e.g (gain ds-cc2 200).
; pinned-2mesh . n m   = 2 pinned-squares linked together
; pinned-3mesh . n m   = 3 pinned-squares linked together
; pinned-4mesh . n m   = 4 pinned-squares linked together
; pinned!=2mesh . n m d= 2 non-matching parameter squares linked together
;                      = max domain value for surface2 (surface1 = 1)
; box-3mesh . n        = deform 3 faces on a cube
;                        Try (box-gain press) to vary internal press.
; box-6mesh . n        = deform 6 faces on a cube
;                        Try (box-gain press) to vary internal press
; goblet . t          = A 10x7 control-pt square sculpted into a goblet
;                       with constraints and loads. The sequence
;                       has several pauses of length t in 1/1000 of
;                       seconds.  t defaults to 0. Try varying load
;                       gains of tag-objects ds-dp1 and ds-dp2.
; goblet2             = Same as goblet plus an attractor for fun.
; space-bug . n m     = An nxm control-pt square with crv_tang constraints
;;

;; SYSTEM MODELING FUNCTIONS
; do-nurbs()     = force dsdemo.scm to build NURB faces
; do-nubs()      = force dsdemo.scm to build NUB faces
; clear()        = sequence to clear all ds demo data
; ds-pick( . e)  = binds a picked face to ds-model for further
;                  sculpting. e = elem_count in each dir (default 3)
; solve( . n)    = call solver n times (default 1)
; end()          = end_sculpting without commiting to face
; commit()       = save dsurf data in ACIS face
; dface(n,m)     = start over with [nxm] control pt face
; ds-default-params (model) = reset all sculpting paramaters
; dedge(n . x0 umin umax) = start over with a n control pt edge
; shape(flag.tgt)= set_default_shape
;                       flag = 1, use current shape
;                       flag = 0, set default to zero
; mesh(n . m f)  = set u and v elem counts
;                      m not needed for edges
;                      m defaults to n for faces
;                      f: 0=fit everywhere,1=fit cstrns,2=use best fit
;                      f defaults to 0
;
; split(a . b ...) = split dmod with dpts[(a a) (b b) ...]
; inc-degree( . degree)   = increase the surface's polynomial degree by one
;                           or to the degree level
; slider(tag inc)= set mouse slider to tag item with given gain_inc
; talking        = toggle amount of text to command line

;; RENDERING AND REPORTS
; draw(state)   = call (ds:set-draw-state ds-model state)
; a()           = 'all'   = render only loads,cstrns,seams,and control_pts
; b()           = 'basic' = render only loads and constraints
; c()           = 'cPts'  = render only control points
; e()           = 'elems' = render only loads,cstrns, and elems
; g()           = 'gausspts'  = render only loads,cstrns, and gauss points
; k()           = 'curvature' = render loads,cstrns, and curvature combs
; t()           = 'tangs' = render only loads,cstrns, and cstrn_tangs
; s()           = 'seams' = render only loads,cstrns, and seams

; et()          = render 'elems' + 'tangs'
; ek()          = render 'elems' + 'curvature'
; es()          = render 'elems' + 'seams'
; est()         = render 'elems' + 'seams' + 'tangs'
; eks()         = render 'elems' + 'curvature' + 'seams'
; ks()          = render 'curvature' + 'seams'
; kt()          = render 'curvature' + 'tangs'
; kst()         = render 'curvature' + 'seams' + 'tangs'
; st()          = render 'seams' + 'tangs'

; grid(n.tgt)      = render grid set to nxn
; d()           = debug ds-model (output a text description)

; set-comb(cnt,gain) = set curvature comb graphics
;                       cnt  = number of tines per elem
;                       gain = length of curvature vectors

; size(r)            = set icon size radius = r
; disp-gain(g . tgt) = set graphic scaling for tang_vec cstrns
; tag-type(tag)      = return tag_type identifier or -1 for invalid tag
; tag-loc(tag)       = return tag position or () when pos is undefined
; ds:pick-tag        = pick tag object to get its tag value
; ds:display-tags(m) = set mode: 0=no printing, 1=printing
; ds:pick-uv         = pick tag object for uv location
; ds:pick-xyz        = pick tag object for xyz location
; tags               = (ds:get-tag-summary ds-model)

;; PATCHES
; add-patch(x0 y0 x1 y1) = add square patch
; rm-patch(tag)          = rm patch identified by tag number

;; DSURF MODEL PARAMETERS (tgt = -2 for all these functions)
; alpha(au.av)  = set resistance to stretch (au = av = val; atheta = 0)
; beta (bu.bv)  = set resistance to bending (bu = bv = val; btheta = 0)
; gamma(val)    = set resist bending change rate value (g = 10)
; delta(val)    = set resist motion from default(d1 = val)
; dyn(dt,m,d)   = set time integration parameters(m=mass, d=damp)

;; DSURF EDGE CONDITIONS
; open(dir)       = set srf end condition to open     dir: 0=u or 1=v
; closed(dir)     = set srf end condition to closed   dir: 0=u or 1=v
; periodic(dir)   = set srf end condition to periodic dir: 0=u or 1=v
; singular(dir s) = set srf singularity, dir: 0=u or 1=v
;                                        s:0=none,1=lo,2=hi,3=both
;    su0          = singular u none
;    su1          = singular u low
;    su2          = singular u high
;    su3          = singular u both
;    sv0          = singular v none
;    sv1          = singular v low
;    sv2          = singular v high
;    sv3          = singular v both

;; REMOVE/TOGGLE/CHANGE CONSTRAINTS AND LOADS
; delete(tag)   = delete cstrn or load (tag=an int identifier)
; dp4()         = delete the pts added by p4()
; toggle(tag)   = toggle cstrn on/off state(tag=an int identifier)
; t4()          = toggle cstrns (1 2 3 4)
; suv(tag uv)   = set a pt cstrn/load uv value(tag=an int identifier)
; sxyz(tag pos) = set a pt cstrn xyz value(tag=an int identifier)
; conv(tag)     = convert crv_cstrn into a crv_load
; behavior(tag str) = set cstrn's behavior "position" "pos_tan" "tangent"

;; ADD CONSTRAINTS
; pc(uv)        = add pos pt constraint at u v loc
; nc(uv)        = add norm pt constraint at u v loc
; pnc(uv)       = add pos_tan pt constraint at u v loc
; p4()          = add pt_cstrns on 4 corners
; cc(uv0 uv1)   = add str curve constraint from uv0 to uv1
; str-cstrn(uv0 uv1) = cc(uv0 uv1)
; cir-cstrn(u v r)= add circle cstrn with ctr=u,v rad = r
; par-cstrn()   = apply a test parabola crv_cstrn(tag=ds-cc1)


;; ADD/EDIT LOADS
; gain(tag gain) = set_load_gain for load with given tag
; pp(uv . gain)  = add pressure pt at uv loc with gain (default 100)
;   f5()         = add 5 pt_loads near middle
;   af(gain)     = increment all pt load gains
;   sf(gain)     = set all pt load gain values
; spr(uv . gain) = add spring load at uv loc with gain (default 500)
; not-available: slider(uv.gain)= add sliding spring load
;   asf(gain)    = increment all spring load gains
;   ssf(gain)    = set all spring load gain values
; dp( . gain uv0 uv1)  = add distributed pressure with gain (default 500)
; gravity( . g)  = add vector load
; attractor( . g)= add attractor load

; cl(uv0 uv1)    = add str curve load from uv0 to uv1
; clz(u z r . g) = add u-param str curve to circle load
; cir-load(u v r. g) = add circ load u,v =ctr r =rad, g =gain
; par-load()     = apply a test parabola crv_load(tag=ds-cload1)

;;============================================================
;; Begin Scheme Definitions
;;============================================================
(provide 'DSdemo)
(require 'DSmouse "dsmouse.scm")
(require 'DScurv "dscurv.scm")

;; DEMO FUNCTIONS

;; some demo sequences

;; compare point-constraints, curve-constraints, and curv-loads
(define (pinned-square . opt)       ; square pinned at the corners
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0)
      (p4) (t4) (set! ds-pt1 (pc 0.5 0.5)) (solve) )))

(define (hinged-square . opt)       ; square pinned on its edges
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1  0)
      (set! ds-pt1 (pc 0.5 0.5)) (solve))))

(define (hung-square . opt)       ; squared loaded on its edges
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0)
      (set! ds-cc1 (conv 3)) (set! ds-cc2 (conv 4))
      (set! ds-cc3 (conv 5)) (set! ds-cc4 (conv 6))
      (p4) (set! ds-pt1 (pc 0.5 0.5)) (solve)
      (ds:set-mouse-slider ds-cc1 500)
      (display "\nTrack center point\n")
      (display "Vary spring loads with (hung-gain gain)\n\n")
      )))

(define (hung-gain ld-gain)
  (ds:set-load-gain ds-model ds-cc1 ld-gain)
  (ds:set-load-gain ds-model ds-cc2 ld-gain)
  (ds:set-load-gain ds-model ds-cc3 ld-gain)
  (ds:set-load-gain ds-model ds-cc4 ld-gain)
  (solve)
  )

(define (gravity-square . opt)       ; square loaded by gravity
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0) (p4) (t4)
      (set! ds-pt1 (pc 0.5 0.5)) (gravity) (solve) )))

(define (attractor-square . opt)     ; square loaded by attractor
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0)
      (p4) (t4)
      (set! ds-pt1 (pc 0.5 0.5)) (attractor) (solve) )))


(define (normal-square . opt)       ; square w/ pinned normals at the corners
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0)
      (p4) (set! ds-pt1 (pc 0.5 0.5)) (solve)
      (behavior 7 'pn) (behavior 8 'pn) (behavior 9 'pn) (behavior 10 'pn)
      (behavior 11 'pn) )))

(define (folding-square . opt)
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0)
      (p4) (t4) (set! ds-pt1 (pc 0.5 0.5))
      (alpha 10 1) (beta .1 2) (sxyz ds-pt1 18 18 25)
      (solve)
      (ds:set-default-shape ds-model 1 1)
      (delta 10) (alpha 1 10)
      (solve)
      (sxyz ds-pt1 18 18 -20)
      (solve))))

(define (corner-00 . opt)                 ; square with internal str cstrn
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
      (toggle 7) (cc 0.0 0.5 0.5 0.0) (set! ds-pt1 (pc 0.5 0.5)))))

(define (par-00 . opt)                     ; square with internal parabola cstrn
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
      (toggle 7)
      (set! ds-cc1 (ds:add-parab-cstrn ds-model 1 "position"
                                       (par-pos 0.0 0.7) (par-pos 0.0 0.0) (par-pos 0.7 0.0) ))
      (set! ds-pt1 (pc 0.5 0.5)))))

(define (circ1-cstrn . opt)          ; square constrainted through a circ
  (let ( (n (if (not (null? opt)) (car opt) 8)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m) (p4) (t4)
      (ds:set-default-shape ds-model 1 0) (solve)
      (set! ds-cc1 (cir-cstrn 0.5 0.5 0.3))
      (dp4) (set! ds-pt1 (pc 0.5 0.5)) (solve))))

(define (circ2-cstrn . opt)          ; square constrained through 2nd circ
  (let ( (n (if (not (null? opt)) (car opt) 9)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m) (p4) (t4)
      (ds:set-default-shape ds-model 1 0) (solve) (dp4)
      (set! ds-cc1 (ds:add-circ-cstrn ds-model 1 "position"
                                      (par-pos 0.6 0.6) (par-pos 0.3 0.1) (par-pos 0.1 0.3)))
      (set! ds-pt1 (pc 0.6 0.6)) (solve)
      (display "\n Try tracking with dynamics")
      (display "\n Execute (dyn .1 100 1) and track again\n"))))

(define (circ3-cstrn . opt)
  (let ( (n (if (not (null? opt)) (car opt) 9)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m) (p4) (t4)
      (ds:set-default-shape ds-model 1 0) (solve)
      (set! ds-pt5 (pc 0.6 0.6))
      (ds:set-pt-xyz ds-model ds-pt5 0 (position 21.6 21.6 10))
      (solve)  (dp4)
      (set! ds-cc1 (ds:add-circ-cstrn ds-model 1 "position"
                                      (par-pos 0.6 0.6) (par-pos 0.3 0.1) (par-pos 0.1 0.3)))
      (display "\n Try tracking with dynamics")
      (display "\n Execute (dyn .1 100 1) and track again\n"))))

(define (circ1-load . opt)          ; square loaded through a circ
  (let ( (n (if (not (null? opt)) (car opt) 8)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m) (p4) (t4)
      (ds:set-default-shape ds-model 1 0) (solve) (dp4)
      (set! ds-cc1 (cir-load 0.5 0.5 0.3 1000))
      (set! ds-pt1 (pc 0.5 0.5)) (solve)
      (ds:set-mouse-slider ds-cc1 500)
      (display "\nTrack center point")
      (display "\nVary curve gain with (gain ds-cc1 value) (solve)\n\n")
      )))

(define (circ2-load . opt)          ; square loaded thruough 2nd circ
  (let ( (n (if (not (null? opt)) (car opt) 9)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m) (p4) (t4)
      (ds:set-default-shape ds-model 1 0) (solve) (dp4)
      (set! ds-cc1 (cir-load 0.6 0.6 0.3 1000))
      (set! ds-pt1 (pc 0.6 0.6)) (solve)
      (ds:set-mouse-slider ds-cc1 500)
      (display "\nTrack center point")
      (display "\nVary curve gain with (gain ds-cc1 value) (solve)\n\n")
      )))

(define (hinged-circ . opt)       ; square pinned on its edges and by a circ
  (let ( (n (if (not (null? opt)) (car opt) 11)) )
    (let ( (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      (dface n m)
      (ds:set-default-shape ds-model 1 0) (solve) (set! ds-cc1 (cir-cstrn 0.5 0.5 0.2))
      (set! ds-cc2 (dp 1000)) (beta 0) (ds:solve ds-model 1 -1) (e)
      (ds:set-mouse-slider ds-cc2 500)
      (display "\nVary pressure load with (gain ds-cc2 value) (solve)\n\n")
      )))

;;==========================================================
;; multisurface sequences
;;==========================================================

(define (pinned-2mesh . opt)       ; square pinned at the corners
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (deg (if (< n 4) (- n 1) 3))
           (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      ; execute (end) in case we are sculpting another model
      (end)
      
      ; barely interesting debug information
      ;; (display "\n n   = ") (display n)
      ;; (display "\n m   = ") (display m)
      ;; (display "\n deg = ") (display deg)
      ;; (display "\n")
      
      ; make a two face model
      ; ds-model1 and ds-model2 are faces
      (set! ds-model1 (ds:test-face n m               ; cpt counts
                                    20 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    0 0               ; x0 y0
                                    0 0               ; domain min
                                    1 1))             ; domain max
      (set! ds-model2 (ds:test-face n m               ; cpt counts
                                    20 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    20 0              ; x0 y0
                                    0  0              ; domain min
                                    1  1))            ; domain max
      ;bmt(entity:erase (entity:owner ds-model1))
      ;bmt(entity:erase (entity:owner ds-model2))
      (view:edges #f);bmt
      
      ; make the sheet
      (set! ds-model4 (solid:stitch (entity:owner ds-model1)
                                    (entity:owner ds-model2)
                                    #t ) )
      ; for debug
      ;; (entity:check ds-model4)
      
      ;; remember all demo short cuts work on the ds-model variable.
      ;; build a deformable model for face 1 and face 2.
      (set! ds-model ds-model1)
      (ds-default-params ds-model1)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 0 0) (pc 0 1) (pc 1 1) (pc 1 0)
      (set! ds-pt1 (pc 0.5 0.5))
      (solve)
      
      (set! ds-model ds-model2)
      (ds-default-params ds-model2)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 1 0) (pc 1 1)
      (set! ds-pt2 (pc 0.5 0.5))
      (solve)
      
      ;; combine the faces into a multisurf mesh
      (set! ds-dm1 (ds:link-face ds-model1 ds-model2))
      (set! ds-model3 (car ds-dm1))
      (set! ds-pt2 (+ ds-pt2 (cadr ds-dm1)))
      
      ;; track a point on each of the surfaces
      (ds:set-pt-xyz ds-model ds-pt1 0 (position 10 10 10)) (solve)
      (ds:set-pt-xyz ds-model ds-pt2 0 (position 30 10 10)) (solve)
      
      ;; add a distributed pressure
      (ds:add-dist-press ds-model 2 400) (solve)
      (define slide-press (ds:add-dist-press ds-model ds-model3 -400)) (solve)
      (ds:set-mouse-slider slide-press 4000)
      
      ;; convert a point constraint into a surface normal constraint
      (ds:set-cstrn-behavior ds-model ds-pt2 "pn") (solve)
      
      ;; make the link C2
      (ds:set-cstrn-behavior ds-model 4 'pll_tll) (solve)
      
      ;; inform the public
      (display "\n(vary pressure with <shift-ctrl-left> mouse)\n")
      
      )))  ;; end (pinned-mesh)

(define (pinned-3mesh . opt)       ; square pinned at the corners
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (deg (if (< n 4) (- n 1) 3))
           (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      ; execute (end) in case we are sculpting another model
      (end)
      
      ; barely interesting debug information
      ;; (display "\n n   = ") (display n)
      ;; (display "\n m   = ") (display m)
      ;; (display "\n deg = ") (display deg)
      ;; (display "\n")
      
      ; make a three face model
      (set! ds-model1 (ds:test-face n m               ; cpt counts
                                    20 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    0 0               ; x0 y0
                                    0 0               ; domain min
                                    1 1))             ; domain max
      (set! ds-model2 (ds:test-face n m               ; cpt counts
                                    20 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    20 0              ; x0 y0
                                    0  0              ; domain min
                                    1  1))            ; domain max
      (set! ds-model3 (ds:test-face (- (* 2 n) deg) m         ; cpt counts
                                    40 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    0 -20             ; x0 y0
                                    0  0              ; domain min
                                    1  1))            ; domain max
      ;bmt(entity:erase (entity:owner ds-model1))
      ;bmt(entity:erase (entity:owner ds-model2))
      ;bmt(entity:erase (entity:owner ds-model3))
      (view:edges #f);bmt
      (set! ds-mesh (solid:stitch (entity:owner ds-model1)
                                  (entity:owner ds-model2)
                                  #t ) )
      (set! ds-mesh (solid:stitch ds-mesh
                                  (entity:owner ds-model3)
                                  #t ) )
      ; (entity:check ds-mesh)
      ;; remember all demo short cuts work on the ds-model variable.
      ;; build a deformable model for the faces
      (set! ds-model ds-model1)
      (ds-default-params ds-model1)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 0 1)
      (set! ds-pt1 (pc 0.5 0.5))
      
      (set! ds-model ds-model2)
      (ds-default-params ds-model2)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 1 1)
      (set! ds-pt2 (pc 0.5 0.5))
      
      (set! ds-model ds-model3)
      (ds-default-params ds-model3)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 0 0) (pc 1 0)
      (toggle 7)
      (set! ds-pt3 (pc 0.5 0.8))
      
      ;; combine the faces into a multisurf mesh
      (set! ds-model4 (ds:link-face ds-model1 ds-model2))
      (set! ds-model5 (ds:link-face ds-model1 ds-model3))
      (set! ds-pt2 (+ ds-pt2 (cadr ds-model4)))
      (set! ds-pt3 (+ ds-pt3 (cadr ds-model5)))
      
      ;; turn on C1 behaviors
      (behavior 3  'pll_tll)
      (behavior 4  'pll_tll)
      (behavior 14 'pll_tll)
      
      ;; pick a flexible beta
      (ds:set-beta ds-model -2 .4)
      
      ;; set a tangent point constraint
      (behavior ds-pt3 'pn)
      (solve)
      
      )))  ;; end (pinned-Tmesh)

(define (pinned-4mesh . opt)       ; square pinned at the corners
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (deg (if (< n 4) (- n 1) 3))
           (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      ; execute (end) in case we are sculpting another model
      (end)
      
      ; barely interesting debug information
      ;; (display "\n n   = ") (display n)
      ;; (display "\n m   = ") (display m)
      ;; (display "\n deg = ") (display deg)
      ;; (display "\n")
      
      ; make a four face model
      (set! ds-model1 (ds:test-face n m               ; cpt counts
                                    20 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    0 0               ; x0 y0
                                    0 0               ; domain min
                                    1 1))             ; domain max
      (set! ds-model2 (ds:test-face n m               ; cpt counts
                                    20 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    20 0              ; x0 y0
                                    0  0              ; domain min
                                    1  1))            ; domain max
      (set! ds-model3 (ds:test-face n m               ; cpt counts
                                    20 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    0 -20             ; x0 y0
                                    0  0              ; domain min
                                    1  1))            ; domain max
      (set! ds-model4 (ds:test-face n m               ; cpt counts
                                    20 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    20 -20            ; x0 y0
                                    0  0              ; domain min
                                    1  1))            ; domain max
      ;bmt(entity:erase (entity:owner ds-model1))
      ;bmt(entity:erase (entity:owner ds-model2))
      ;bmt(entity:erase (entity:owner ds-model3))
      ;bmt(entity:erase (entity:owner ds-model4))
      (view:edges #f);bmt
      (set! ds-mesh (solid:stitch (entity:owner ds-model1)
                                  (entity:owner ds-model2)
                                  #t ) )
      (set! ds-mesh (solid:stitch ds-mesh
                                  (entity:owner ds-model3)
                                  #t ) )
      (set! ds-mesh (solid:stitch ds-mesh
                                  (entity:owner ds-model4)
                                  #t ) )
      
      ; for debug
      ;; (entity:check ds-mesh)
      
      ;; remember all demo short cuts work on the ds-model variable.
      ;; build a deformable model for the faces
      (set! ds-model ds-model1)
      (ds-default-params ds-model1)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 0 1)
      (set! ds-pt1 (pc 0.5 0.5))
      
      (set! ds-model ds-model2)
      (ds-default-params ds-model2)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 1 1)
      (set! ds-pt2 (pc 0.5 0.5))
      
      (set! ds-model ds-model3)
      (ds-default-params ds-model3)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 0 0)
      (set! ds-pt3 (pc 0.5 0.5))
      
      (set! ds-model ds-model4)
      (ds-default-params ds-model4)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 1 0) (pc 0 1)
      (set! ds-pt4 (pc 0.5 0.5))
      
      ;; combine the faces into a multisurf mesh
      (set! ds-model5 (ds:link-face ds-model1 ds-model2))
      (set! ds-model6 (ds:link-face ds-model1 ds-model3))
      (set! ds-model7 (ds:link-face ds-model1 ds-model4))
      
      ; fix up tag numbers
      (set! ds-pt2 (+ ds-pt2 (cadr ds-model5)))
      (set! ds-pt3 (+ ds-pt3 (cadr ds-model6)))
      (set! ds-pt4 (+ ds-pt4 (cadr ds-model7)))
      
      ;; switch to a C1 surface
      (behavior  3 'pll_tll)
      (behavior  4 'pll_tll)
      (behavior 14 'pll_tll)
      (behavior 25 'pll_tll)
      
      ;; pick a flexible beta value
      (ds:set-beta ds-model -2 .4)
      (solve)
      
      )))  ;; end (pinned+mesh)

(define (pinned!=2mesh . opt)       ; square pinned at the corners
  (let ( (n (if (not (null? opt)) (car opt) 6))
         (d (if (not (or (null? opt)
                         (null? (cdr opt))
                         (null? (cddr opt)) ))
                (caddr opt) 1)) )
    (let ( (deg (if (< n 4) (- n 1) 3))
           (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      ; execute (end) in case we are sculpting another model
      (end)
      
      ; barely interesting debug information
      ;; (display "\n n   = ") (display n)
      ;; (display "\n m   = ") (display m)
      ;; (display "\n deg = ") (display deg)
      ;; (display "\n")
      
      ; make a two face model
      (set! ds-model1 (ds:test-face n m               ; cpt counts
                                    40 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    0 0               ; x0 y0
                                    0 0               ; domain min
                                    1 1))             ; domain max
      (set! ds-model2 (ds:test-face (+ n 1) m         ; cpt counts
                                    40 20 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    0 -20             ; x0 y0
                                    0  0              ; domain min
                                    d d))             ; domain max
      ;bmt(entity:erase (entity:owner ds-model1))
      ;bmt(entity:erase (entity:owner ds-model2))
      (view:edges #f);bmt
      (set! ds-mesh (solid:stitch (entity:owner ds-model1)
                                  (entity:owner ds-model2)
                                  #t ) )
      ; for debugging
      ;; (entity:check ds-mesh)
      
      ;; remember all demo short cuts work on the ds-model variable.
      ;; build a deformable model for the faces
      (set! ds-model ds-model1)
      (ds-default-params ds-model1)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 0 1) (pc 1 1)
      (set! ds-pt1 (pc 0.5 0.5))
      
      (set! ds-model ds-model2)
      (ds-default-params ds-model2)
      (ds:set-default-shape ds-model 1 0) (b) (t4)
      (pc 0 0) (pc 1 0)
      (set! ds-pt2 (pc 0.5 0.5))
      
      ;; add some points to force a bend
      (pc .125 1)
      (pc .5  .95)
      (pc .875 1)
      
      ;; combine the faces into a multisurf mesh
      (set! ds-model3 (ds:link-face ds-model1 ds-model2))
      
      ;; pick a flexible beta value
      (ds:set-beta ds-model -2 .4)
      ;    (solve)
      
      )))  ;; end (pinned!=mesh)

(define (box-3mesh . opt)        ; opt = element count
  (let (   (n (if (not (null? opt)) (car opt) 3)))
    (let ( (del (/ 1.0 n))
           (a (list)))
      
      ; execute (end) in case we are sculpting another model
      (end)
      
      ; build a block
      (set! ds-dm1 (solid:block (position 0 0 0) (position 30 30 30)))
      
      ; bind one face to the convenience globals and mouse
      (set! ds-model (car (entity:faces ds-dm1)))
      (ds:mouse ds-model)
      
      ; combine the 3 faces (pair-wise)
      (set! ds-model1 (car
                        (ds:link-face ds-model (caddr (entity:faces ds-dm1)))))
      (set! ds-model2 (car
                        (ds:link-face ds-model (caddr (cdddr (entity:faces ds-dm1))))))
      
      ; split the faces to add elements
      (do ((i 1 (+ i 1))) ((= i n))
          (set! a (append a (list (par-pos (* i del)(* i del)))))
          )
      (ds:split-domain ds-model 2 a)
      (ds:split-domain ds-model ds-model1 a)
      (ds:split-domain ds-model ds-model2 a)
      
      ; add a vertex point constraint
      (set! ds-pt1 (pc 1.0 0.0))
      
      ; clean up the graphics
      ;bmt(entity:erase ds-dm1)
      (view:edges #f);bmt
      
      ; add pressures to all the faces
      (set! ds-dp1 (ds:add-dist-press ds-model 2         0))
      (set! ds-dp2 (ds:add-dist-press ds-model ds-model1 0))
      (set! ds-dp3 (ds:add-dist-press ds-model ds-model2 0))
      (set! ds-dp4 0)
      (set! ds-dp5 0)
      (set! ds-dp6 0)
      
      ; change the shape
      (ds:toggle-cstrn ds-model ds-pt1)
      (ds:set-default-shape ds-model -2 0)
      (ds:set-beta ds-model -2 .2)
      (solve)
      (ds:toggle-cstrn ds-model ds-pt1)
      (solve)
      
      ; help the user use a pressure
      (display "\ntry (box-gain pressure) to vary a box pressure\n")
      
      ; save the results
      ; (commit) (end)
      ))) ; end box-3mesh (two lets and a define)

(define (box-6mesh . opt)        ; opt = element count
  (let (   (n (if (not (null? opt)) (car opt) 3)))
    (let ( (del (/ 1.0 n))
           (a (list)))
      
      ; execute (end) in case we are sculpting another model
      (end)
      
      ; build a block
      (set! ds-dm1 (solid:block (position 0 0 0) (position 30 30 30)))
      
      ; bind one face to the convenience globals and mouse
      (set! ds-model (car (entity:faces ds-dm1)))
      (ds:mouse ds-model)
      
      ; combine the 6 faces (pair-wise) (order is important)
      (set! ds-model1 (car
                        (ds:link-face ds-model (caddr (entity:faces ds-dm1)))))
      (set! ds-model2 (car
                        (ds:link-face ds-model (cadr (entity:faces ds-dm1)))))
      (set! ds-model3 (car
                        (ds:link-face ds-model (cadddr (entity:faces ds-dm1)))))
      (set! ds-model4 (car
                        (ds:link-face ds-model (cadr (cdddr (entity:faces ds-dm1))))))
      (set! ds-model5 (car
                        (ds:link-face ds-model (caddr (cdddr (entity:faces ds-dm1))))))
      
      ; split the faces to add elements
      (do ((i 1 (+ i 1))) ((= i n))
          (set! a (append a (list (par-pos (* i del)(* i del)))))
          )
      (ds:split-domain ds-model 2         a)
      (ds:split-domain ds-model ds-model1 a)
      (ds:split-domain ds-model ds-model2 a)
      (ds:split-domain ds-model ds-model3 a)
      (ds:split-domain ds-model ds-model4 a)
      (ds:split-domain ds-model ds-model5 a)
      
      ; add 8 vertex point constraints
      (set! ds-pt1 (pc 0.0 0.0))
      (set! ds-pt2 (pc 1.0 0.0))
      (set! ds-pt3 (pc 1.0 1.0))
      (set! ds-pt4 (pc 0.0 1.0))
      
      (ds:add-pt-cstrn ds-model ds-model3 "p" (par-pos 0.0 0.0))
      (ds:add-pt-cstrn ds-model ds-model3 "p" (par-pos 1.0 0.0))
      (ds:add-pt-cstrn ds-model ds-model3 "p" (par-pos 1.0 1.0))
      (ds:add-pt-cstrn ds-model ds-model3 "p" (par-pos 0.0 1.0))
      
      ; add pressures to all the faces
      (set! ds-dp1 (ds:add-dist-press ds-model 2         0))
      (set! ds-dp2 (ds:add-dist-press ds-model ds-model1 0))
      (set! ds-dp3 (ds:add-dist-press ds-model ds-model2 0))
      (set! ds-dp4 (ds:add-dist-press ds-model ds-model3 0))
      (set! ds-dp5 (ds:add-dist-press ds-model ds-model4 0))
      (set! ds-dp6 (ds:add-dist-press ds-model ds-model5 0))
      
      ; clean up the graphics
      ;bmt(entity:erase ds-dm1)
      (view:edges #f);bmt
      
      ; change the shape
      (ds:set-default-shape ds-model -2 0)
      (ds:set-beta ds-model -2 .4)
      (box-gain -150)
      (solve)
      
      ; help the user use a pressure
      (display "\ntry (box-gain pressure) to vary a box pressure\n")
      
      ; save the results
      ; (commit) (end)
      ))) ; end box-6mesh (two lets and a define)

(define (box-gain press)      ; used with box-3mesh and box-6mesh
  (ds:set-load-gain ds-model ds-dp1 press)
  (ds:set-load-gain ds-model ds-dp2 press)
  (ds:set-load-gain ds-model ds-dp3 press)
  (if (not (= ds-dp4 0)) (ds:set-load-gain ds-model ds-dp4 press))
  (if (not (= ds-dp5 0)) (ds:set-load-gain ds-model ds-dp5 press))
  (if (not (= ds-dp6 0)) (ds:set-load-gain ds-model ds-dp6 press))
  (solve)
  )

;;==========================================================
;; simple object sequences
;;==========================================================

;; try making a goblet
(define (goblet . opt)        ; opt equal pauses in 1/1000 seconds
  ( let ((pause (if (not (null? opt))
                    (car opt)
                    0)))
    (dface 10 7 0.0 0.0 0 0 25 25)
    (display "\n  Add periodic constraints")
    (periodic 1)
    (display "\n  Toggle edge constraints off")
    (t4)
    (display "\n  Add curve-loads to shape surface")
    (set! ds-cload1 (clz 0 0 6 20000))   ; add circ at base z=0 r=6
    (set! ds-cload2 (clz 1 18 6 20000))  ; add circ at top z=18 r=6
    (set! ds-cc1 (clz .5 9 1 5000))   ; add circ at center
    (display "\n  Set default shape to 0")
    (ds:set-default-shape ds-model 1 0)
    (display "\n  Add 0 gain dist-pressures - top and bot . ")
    (set! ds-dp1 (dp 0   0 0   .3 1))
    (set! ds-dp2 (dp 0   .8 0   1 1))
    (display "pause ") (display (* pause 3)) (system:sleep (* pause 3))
    (display "\n  Solve for shape . ")
    (grid 30)
    (solve 2 3)
    (display "pause ") (display pause) (system:sleep pause)
    (display "\n  Toggle end edge constraints back on\n")
    (toggle 4)
    (toggle 6)
    (display "\n  Remove end curve-loads . \n")
    (delete ds-cload1)
    (delete ds-cload2)
    (display "\n  Stiffen Alpha and beta in u direction . ")
    (alpha 5 1)
    (beta 10 1)
    (display "\n  Add 0 gain  dist-pressure to entire surf . \n")
    (dp 0)
    (gain ds-cc1 0)
    (display "pause ") (display pause) (system:sleep pause)
    (display "\n  Solve for shape . ")
    (solve 2 3)
    (gain ds-cc1 50000)
    (display "\n  Add 2nd curve load at center . ")
    (set! ds-cc2 (clz .35 7 1 50000))   ; add circ at center
    (display "pause ") (display pause) (system:sleep pause)
    (display "\n  Solve for shape . ")
    (solve)
    (display "pause ") (display pause) (system:sleep pause)
    (display "\n  Set press-gain to puff goblet bowl . ")
    (gain ds-dp1 150000)
    (display "\n  Solve for shape . ")
    (solve 2 3)
    (display "pause ") (display pause) (system:sleep pause)
    (display "\n  Capture this as default shape")
    (ds:set-default-shape ds-model 1 1)
    (display "\n  Set press-gain to puff goblet stem . ")
    ; insert stiffness into default shape and turn curve gains back on
    (delta 10000)
    (gain ds-cc1 50000)
    (gain ds-cc2 50000)
    (gain ds-dp2 -200000)
    (display "\n  Solve for shape . ")
    (solve 2 3)
    (display "pause ") (display pause) (system:sleep pause)
    (display "\n  Capture this as default shape . ")
    (ds:set-default-shape ds-model 1 1)
    (display "\n  Modify press-gains to tune shape . ")
    (gain ds-cc1 50000)
    (gain ds-cc2 50000)
    (gain ds-dp2 -50000)
    (gain ds-dp1  50000)
    (display "\n  Solve for shape . ")
    (solve 2 3)
    (display "\n  Capture this as default shape . ")
    (ds:set-default-shape ds-model 1 1)
    (gain ds-cc1 50000)
    (gain ds-cc2 50000)
    (solve 2 3)
    (ds:set-mouse-slider ds-dp2 -200000)
    (display "\n\nVary bowl pressure with mouse-slider")
    (display "\nTrack <SHIFT-CTRL-LEFT> to left and right\n")
    ))

;; same goblet but now add an attractor for fun
(define (goblet2) (goblet)
  (ds:set-default-shape ds-model 1 1) (size 5) (grid 30)
  (ds:rm-tag-object ds-model 13)
  (ds:rm-tag-object ds-model 9)
  (ds:add-attractor ds-model 1 1000))


;; space-bug(n m) = variation on hinged-square with tang constraints
(define (space-bug . opt)
  (let ((n (if (not (null? opt))
               (car   opt)  9))
        (m (if (not (or (null? opt) (null? (cdr opt))))
               (cadr  opt)  9)))
    (hinged-square n m)
    (ds:elevate-degree ds-model 1 1)
    (gamma 0)
    (ds:set-draw-state ds-model 1 (+ ds-draw-cstrns
                                     ds-draw-loads
                                     ds-draw-cstrn-norms))
    (ds:set-cstrn-behavior ds-model 3 "pos_norm")
    (ds:set-pt-xyz ds-model ds-pt1 0 (position 18 18 10))
    (ds:set-tang-gain ds-model 3 -1.0)
    (ds:set-draw-grid ds-model 1 30 30)
    (toggle 4)
    (toggle 6)
    (solve)
    (ds:set-pt-xyz ds-model ds-pt1 0 (position 18 18 30))
    (set! ds-dp1 (ds:add-dist-press ds-model 1 500
                                    (par-pos 0 0) (par-pos 1 .25)))
    (set! ds-dp2 (ds:add-dist-press ds-model 1 500))
    (set! ds-spr (ds:add-spring-curve ds-model 1
                                      (par-pos 0 .15) (par-pos 1 .15)
                                      (position -5 -15 7) (position 41 -15 7) 20000))
    (set! ds-pt2 (ds:add-pt-cstrn ds-model 1  "position" (par-pos .5 .25)))
    (ds:set-pt-xyz ds-model ds-pt2 0 (position 18 -27 14))
    (solve)
    (ds:set-mouse-slider ds-spr 20000)
    (display "\n\nVary spring stiffness with mouse slider")
    (display "\nTrack <CTRL-SHIFT-LEFT> to left and right\n")
    (display "\nAlso Try puff: reset mouse slider with\n")
    (display "       (ds:set-mouse-slider ds-dp2 50000)\n")
    ))


;; SYSTEM MODELING FUNCTIONS

(define (do-nurbs)       ; force dsdemo.scm to build NURB faces
  (set! ds-rational-flag 1))

(define (do-nubs)        ; force dsdemo.scm to build NUB faces
  (set! ds-rational-flag 0))

(define (clear)          ; clear = sequence to clear all ds demo data
  (display "clear\n")
  (part:clear)
  (view:refresh)
  (set! ds-model '())
  (ds:mouse '())
  )

(define (track-on)  (ds:set-auto-curve-tracking 1) )
(define (track-off) (ds:set-auto-curve-tracking 0) )

(define (ds-pick . opt)  ; ds-pick = bind a picked face to ds-model
  (if (null? opt)        ; opt = number of elems in each direction
      (ds:select-face)
      (ds:select-face (car opt)))
  )

(define (solve . opt)            ; solve = call solver
  (let ((iter (if (not (null? opt))
                  (car opt)
                  1)))
    (ds:solve ds-model 1 iter)
    ))

(define (end)                  ; end = end_sculpting
  (cond ((not( null? ds-model))
         (ds:end-sculpting ds-model)
         (set! ds-model '())
         (ds:mouse '())
         (view:refresh))
        ))

(define (commit)             ; commit = commit_to_face
  (ds:commit ds-model))

(define (dface n m . opt)    ; dface(n m . x0 y0 min_uv max_uv) = start over with NxM surf
  (let
    ((deg (if (< n 4) (- n 1) 3))
     (x0 (if (not (null? opt))
             (car opt)    0.0))
     (y0 (if (not (or (null? opt) (null? (cdr opt)) ))
             (cadr opt)   0.0))
     (u_min (if (not (or (null? opt) (null? (cdr opt))
                         (null? (cddr opt)) ))
                (caddr opt)    0.0))
     (v_min (if (not (or (null? opt) (null? (cdr opt))
                         (null? (cddr opt)) (null? (cdddr opt)) ))
                (cadddr opt)   0.0))
     (u_max (if (not (or (null? opt) (null? (cdr opt))
                         (null? (cddr opt)) (null? (cdddr opt))
                         (null? (cdr (cdddr opt))) ))
                (cadr (cdddr opt))  1.0))
     (v_max (if (not (or (null? opt) (null? (cdr opt))
                         (null? (cddr opt)) (null? (cdddr opt))
                         (null? (cdr (cdddr opt)))
                         (null? (cddr (cdddr opt))) ))
                (caddr (cdddr opt)) 1.0))
     )
    (end)
    (set! ds-model (ds:test-face n m               ; cpt counts
                                 36 36 0           ; xyz sizes
                                 ds-rational-flag  ; rational flag
                                 deg deg           ; uv degrees
                                 x0 y0             ; x0 y0
                                 u_min v_min       ; domain min
                                 u_max v_max))     ; domain max
    ;bmt(entity:erase ds-model)
    (view:edges #f);bmt
    (ds-default-params ds-model)
    ds-model
    ))

(define (ds-default-params model)
  (set! ds-model model)
  (ds:set-alpha ds-model 1 1.2 1.2 0)
  (ds:set-beta ds-model 1 5 5 0)
  (ds:set-gamma ds-model 1 0.0)
  (ds:set-dynamics ds-model 1 1 0 0)
  (ds:set-draw-state ds-model 1 (+ ds-draw-cstrns
                                   ds-draw-loads))
  (ds:mouse ds-model #f)
  )

(define (dedge n . opt)             ; dedge(n . x0 opt) = new_curve
  (let                                   ; opt =  u_min(def=0)
    ((x0    (if (not (null? opt))     ;            u_max(def=1)
                (car opt)  0.0))
     (u_min (if (not (or (null? opt)
                         (null? (cdr opt)) ))
                (cadr opt)  0.0))
     (u_max (if (not (or (null? opt)
                         (null? (cdr opt))
                         (null? (cddr opt)) ))
                (caddr opt) 1.0)))
    (end)
    ;  (display "\n n =")(display n)
    ; (display "\n u_min =")(display u_min)
    ; (display "\n u_max =")(display u_max)(display "\n")
    (set! ds-model (ds:test-edge n 36 0
                                 ds-rational-flag 3
                                 x0
                                 u_min u_max))
    (entity:erase ds-model)
    (ds-default-params ds-model)
    ;    (ds:set-alpha ds-model 1 1.2)
    ;    (ds:set-beta ds-model 1 5)
    ;    (ds:set-gamma ds-model 1 0.0)
    ;    (ds:set-dynamics ds-model 1 1 0 0)
    ;    (ds:set-draw-state ds-model 1 (+ ds-draw-cstrns
    ;                                     ds-draw-loads))
    ;    (ds:mouse ds-model #f)
    (ds:set-tan-display-gain ds-model 1 (* (- u_max u_min) .6))
    ;; set the two end point constraints - you get them by default
    ;; so changes in the code may change the tag numbers
    (set! ds-pt1 3)
    (set! ds-pt2 4)
    ds-model
    ))

(define (shape flag . tgt)         ; shape(flag) = set_default_shape
  (if (not (null? tgt))            ; flag: 1 = use current shape
      ;       0 = set default to zero
      (ds:set-default-shape ds-model (car tgt) flag)
      (ds:set-default-shape ds-model 1 flag)) )

(define (mesh u . opt)         ; set elem-counts in u and v
  (let                                   ;   u = u elem_count
    ((v (if (face? ds-model)             ;   for faces opt = [v,f]
            (if (not (null? opt))        ;   for edges opt = [f]
                (car opt)                ;   v = v_elem_count (default = u)
                u)                       ;   f = 0:fit everywhere
            '()))                        ;       1:fit cstrns
     (f (if (face? ds-model)             ;       2:use best fit
            (if (and (not (null? opt))
                     (not (null? (cdr opt)))) ;       (default = 0)
                (cadr opt)
                0)
            (if (not (null? (car opt)))
                (car opt)
                0)))
     )
    (if (face? ds-model)
        (ds:set-elem-count ds-model 1 u v f)
        (ds:set-elem-count ds-model 1 u f))
    ))

(define (split u . opt)     ; split(u0 . opt) = split surf with dpts [(u0 u0) (u1 u1) ...
  (let ((plist (list (par-pos u u))))
    (do ((n opt (cdr n)))
        ((null? n) plist)
        (set! plist (append plist
                            (list (par-pos (car n) (car n)))))
        )
    (ds:split-domain ds-model 1 plist)
    ))

(define (inc-degree . opt)         ; inc-degree()  = inc surf's degree
  (let ((d (if (not (null? opt))
               (- (car opt)(car (ds:get-shape-degree ds-model)))
               1 )))
    (do ((n 0 (+ n 1)))
        ((>= n d) (ds:get-shape-degree ds-model))
        (ds:elevate-degree ds-model 1 1))
    ))
;  ((ds:elevate-degree ds-model 1))

(define (slider tag inc)      ; slider(tag inc)= set mouse slider data
  (ds:set-mouse-slider tag inc))

(define (talking)
  (if ds-mtalk (set! ds-mtalk #f)
      (set! ds-mtalk #t))
  ds-mtalk
  )

;; RENDERING AND REPORTS

(define (draw state . opt)         ; draw(state)   = call (ds:set-draw-state ds-model state)
  (let ((tgt (if (not (null? opt)) (car opt) 1)))
    (ds:set-draw-state ds-model tgt state)))

(define (a . o) (if (not (null? o))     ; a = loads, cstrns, seams, and CntrlPts
                    (draw (+ ds-draw-cpts
                             ds-draw-seams
                             ds-draw-cstrns
                             ds-draw-loads) (car o))
                    (draw (+ ds-draw-cpts
                             ds-draw-seams
                             ds-draw-cstrns
                             ds-draw-loads))))
(define (b . o) (if (not (null? o))     ; b = loads, cstrns
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads) (car o))
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads))))
(define (c . o) (if (not (null? o))     ; c = dsurf control points
                    (draw ds-draw-cpts (car o))
                    (draw ds-draw-cpts)))
(define (e . o) (if (not (null? o))     ; e = loads, cstrns, elems
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads
                             ds-draw-elems) (car o))
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads
                             ds-draw-elems))))
(define (g . o) (if (not (null? o))     ; g = loads, cstrns, gauss_pts
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads
                             ds-draw-gauss-pts) (car o))
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads
                             ds-draw-gauss-pts))))
(define (k . o) (set-comb 25 -100)      ; k = loads, cstrns, curv_combs
  (if (not (null? o))
      (draw (+ ds-draw-cstrns
               ds-draw-loads
               ds-draw-curve-comb) (car o))
      (draw (+ ds-draw-cstrns
               ds-draw-loads
               ds-draw-curve-comb))))
(define (s . o) (if (not (null? o))     ; s = loads, cstrns, seams
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads
                             ds-draw-seams ) (car o))
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads
                             ds-draw-seams))))
(define (t . o) (if (not (null? o))     ; t = loads, cstrns, crv_tangs
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads
                             ds-draw-cstrn-norms) (car o))
                    (draw (+ ds-draw-cstrns
                             ds-draw-loads
                             ds-draw-cstrn-norms))))

(define (et . o)  (if (not (null? o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-elems
                               ds-draw-cstrn-norms) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-elems
                               ds-draw-cstrn-norms))))
(define (ek . o)  (if (not (null? o))              ; ek  = e + k
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-curve-comb
                               ds-draw-elems) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-curve-comb
                               ds-draw-elems))))
(define (es . o)  (if (not (null? o))              ; ek  = e + k
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-seams
                               ds-draw-elems) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-seams
                               ds-draw-elems))))
(define (est . o) (if (not (null? o))              ; ek  = e + k
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-seams
                               ds-draw-elems
                               ds-draw-cstrn-norms) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-seams
                               ds-draw-elems
                               ds-draw-cstrn-norms))))
(define (eks . o) (if (not (null? o))              ; eks  = e + k + s
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-seams
                               ds-draw-elems
                               ds-draw-curve-comb) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-seams
                               ds-draw-elems
                               ds-draw-curve-comb))))
(define (ks . o)  (if (not (null? o))              ; ks  = k + s
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-curve-comb
                               ds-draw-seams) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-curve-comb
                               ds-draw-seams))))
(define (kt . o)  (if (not (null? o))              ; kt  = k + t
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-curve-comb
                               ds-draw-cstrn-norms) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-curve-comb
                               ds-draw-cstrn-norms))))
(define (kst . o) (if (not (null? o))              ; kst = k + t + s
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-curve-comb
                               ds-draw-cstrn-norms
                               ds-draw-seams) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-curve-comb
                               ds-draw-cstrn-norms
                               ds-draw-seams))))
(define (st . o)  (if (not (null? o))              ; st  = t + s
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-seams
                               ds-draw-cstrn-norms) (car o))
                      (draw (+ ds-draw-cstrns
                               ds-draw-loads
                               ds-draw-seams
                               ds-draw-cstrn-norms))))

(define (grid n . o)           ; grid(n) = render grid set to nxn
  (if (not (null? o))
      (ds:set-draw-grid ds-model (car o) n n)
      (ds:set-draw-grid ds-model 1 n n)))

(define (d . opt)            ; d = debug ds-model (print its data)
  (let ((tgt (if (not (null? opt)) (car opt) 1)))
    (ds:debug ds-model tgt)) )

(define (set-comb count gain); set-comb = set comb params
  (ds:set-comb-graphics
    ds-model 1 count gain))

(define (size radius)        ; size(r) = set icon radius size
  (ds:set-icon-radius ds-model
                      radius))

(define (disp-gain g . o)    ; disp-gain g. o = set tan_display_gain for dmod
  (if (not (null? o))
      (ds:set-tan-display-gain ds-model (car o) g)
      (ds:set-tan-display-gain ds-model 1 g)))

(define (tag-type tag)       ; tag-type = return tag_type id or 0
  (ds:get-tag-type ds-model tag))

(define (tag-loc tag)        ; tag-loc = return tag pos or unspeced
  (ds:get-pt-xyz ds-model tag 0))

(define (ds:pick-tag)
  (display "  Pick tag (rtn: tag-id pt-index [position]): ")
  (define tag (ds:pick-tag-id ds-model (read-event)))
  (cond ( (not (= (car tag) -1))
          (display "\n")
          (set! tag (append tag 
                           (list (ds:get-pt-xyz ds-model 
                                               (car tag) 
                                               (cadr tag)))))
        ) ; end tag_id != -1 check
  ) ; end cond
  tag
) ; end define (ds:pick-tag)

(define (ds:display-tags mode)  ;; mode: 0=no printing, 1=printing
  (set! ds-display-tag-flag mode)
  ds-display-tag-flag
)

(define (ds:pick-uv)
  (display "  Pick uv-pt (rtn: par-pos[u v]): ")
  (ds:pick-par-pos ds-model (read-event)) )

(define (ds:pick-xyz)
  (display "  Pick xyz-pt (rtn: dmod position[x y z]): ")
  (ds:pick-position ds-model (read-event)) )

(define (tags . o)
  (if (not (null? o))     ; get tags on target
      (ds:get-tag-summary ds-model (car o))
      (ds:get-tag-summary ds-model )))

;; PATCH FUNCTIONS
(define (add-patch u0 v0 u1 v1) ; add-patch = add square patch
  (ds:add-patch ds-model 1  1
                (par-pos u0 v0)
                (par-pos u1 v1)
                (par-pos u0 v0)
                5)
  )

(define (rm-patch tag)          ; rm-patch = rm patch by id tag
  (ds:rm-patch ds-model tag)
  )

;; DSURF MODEL PARAMETERS

(define (alpha au . av)     ; alpha = set resistance to stretch
  (let
    ((a2 (if (null? av) au (car av))))
    (ds:set-alpha ds-model -2 au a2)
    (solve) ))

(define (beta  bu . bv)     ; beta  = set resistance to bending
  (let
    ((b2 (if (null? bv) bu (car bv))))
    (ds:set-beta  ds-model -2 bu b2)
    (solve) ))

(define (gamma . g)          ; gamma = resist bending change rate value
  (if (not (null? g))
      (ds:set-gamma ds-model -2 (car g))
      (ds:set-gamma ds-model -2 10))
  (solve) )

(define (delta d11)          ; delta = set resist motion from default
  (ds:set-delta ds-model -2 d11)
  (solve) )

(define (dyn dt mass damp)   ; dyn = set time integration parameters
  (ds:set-dynamics ds-model -2
                   dt mass damp))

;; DSURF EDGE CONDITIONS

(define (open dir)           ; open = set end cond to open
  (cond ((= dir 0)
         (ds:set-end-conds ds-model 0 -1 -1 -1))
        ((= dir 1)
         (ds:set-end-conds ds-model -1 -1 0 -1))
        ( else (display "dir: 0=u or 1=v\n")) ))

(define (closed dir)         ; closed = set end cond to closed
  (cond ((= dir 0)
         (ds:set-end-conds ds-model 1 -1 -1 -1))
        ((= dir 1)
         (ds:set-end-conds ds-model -1 -1 1 -1))
        ( else (display "dir: 0=u or 1=v\n")) ))

(define (periodic dir)       ; periodic = set end cond to periodic
  (cond ((= dir 0)
         (ds:set-end-conds ds-model 2 -1 -1 -1))
        ((= dir 1)
         (ds:set-end-conds ds-model  -1 -1 2 -1))
        ( else (display "dir: 0=u or 1=v\n")) ))

; singular(dir s) = set surf singularity dir: 0=u or 1=v
;                          s:0=none,1=lo,2=hi,3=both

(define (singular dir state) ; singular = set edge conds
  (cond ((= dir 0)
         (ds:set-end-conds ds-model -1 state -1 -1))
        ((= dir 1)
         (ds:set-end-conds ds-model -1 -1 -1 state))
        ( else (display "dir: 0=u or 1=v\n")
          (display "sin: 0=none,1=lo,2=hi,3=both\n")) ))

(define (su0) (singular 0 0)) ; su0 = singular u none
(define (su1) (singular 0 1)) ; su1 = singular u low
(define (su2) (singular 0 2)) ; su2 = singular u high
(define (su3) (singular 0 3)) ; su3 = singular u both
(define (sv0) (singular 1 0)) ; sv0 = singular v none
(define (sv1) (singular 1 1)) ; sv1 = singular v low
(define (sv2) (singular 1 2)) ; sv2 = singular v high
(define (sv3) (singular 1 3)) ; sv3 = singular v both

;; REMOVE/TOGGLE/CHANGE CONSTRAINTS AND LOADS

(define (delete tag)         ; delete = delete tag
  (cond ((= 0 (ds:rm-tag-object ds-model tag))
         (display "Tag(")
         (display tag)
         (display ") not deletable\n"))
        (else (display "deleted\n")) ))

(define (dp4)                ; dp4 delete 4 pts created by p4()
  (delete ds-pt1) (delete ds-pt2)
  (delete ds-pt3) (delete ds-pt4))

(define (toggle tag)         ; toggle = toggle cstrn (tag=identifier)
  (ds:toggle-cstrn ds-model tag)
  )

(define (t4)                ; t4 = toggle (3 4 5 6)
  (toggle 3) (toggle 4)      ; the edge constraints made for a
  (toggle 5) (toggle 6))     ; 4 sided face

(define (suv tag u v)        ; suv(tag u v) = set pt cstrn/load uv val
  (ds:set-pt-uv ds-model tag
                (par-pos u v))
  (solve))

(define (sxyz tag x y z)     ; sxyz(tag x y z) = set pt cstrn xyz val
  (ds:set-pt-xyz ds-model tag 0
                 (position x y z))
  (solve))

(define (conv tag)           ; convert(tag) = convert a crv_cstrn to a load
  (ds:crv-load-from-cstrn ds-model tag))

(define (behavior tag str)   ; behavior(tag str) = set cstrn's behavior
  (ds:set-cstrn-behavior     ;  str = "position" "pos_tan" "tangent"
    ds-model tag str))

;; ADD CONSTRAINTS

(define (pc u v)             ; pc = add pt constraint
  (ds:add-pt-cstrn ds-model 1
                   "position" (par-pos u v)))

(define (nc u v)             ; tc = add tangent constraint
  (ds:add-pt-cstrn ds-model 1
                   "normal" (par-pos u v)))

(define (pnc u v)             ; ptc = add pos_tan constraint
  (ds:add-pt-cstrn ds-model 1
                   "pos_norm" (par-pos u v)))

(define (p4)                 ; p4 = add pt_cstrns on 4 corners
  (set! ds-pt1 (pc 0 0)) (set! ds-pt2 (pc 0 1))
  (set! ds-pt3 (pc 1 1)) (set! ds-pt4 (pc 1 0))
  (list ds-pt1 ds-pt2 ds-pt3 ds-pt4))

(define (cc u1 v1 u2 v2)     ; cc = add str curve constraint
  (ds:add-str-cstrn ds-model 1 "position"
                    (par-pos u1 v1)
                    (par-pos u2 v2) ) )
(define (str-cstrn u1 v1 u2 v2)
  (cc u1 v1 u2 v2))

(define (cir-cstrn u v r . g)     ; cir-cstrn = add circ load
  (let                            ;     ctr=u,v rad=r elem_ct=g
    ((elem_cnt (if (not (null? g)) (car g) 8)))
    (ds:add-circ-cstrn ds-model 1 "position"
                       (par-pos u v)
                       (par-pos r 0)
                       (par-pos 0 r) )))

(define (par-cstrn)              ; par-cstrn = apply a test parabola crv_cstrn
  (set! ds-cc1
        (ds:add-parab-cstrn ds-model 1 "position"
                            (par-pos 0.0 0.7)
                            (par-pos 0.0 0.0)
                            (par-pos 0.7 0.0) )))


;; ADD/EDIT LOADS

(define (gain tag lgain)     ; gain = set_load_gain for tag load
  (ds:set-load-gain ds-model tag lgain)
  (ds:solve ds-model) )

(define (pp u v . lgain)     ; pp = add pressure pt
  (let ((gain (if (not (null? lgain)) (car lgain) 100)))
    (ds:add-pt-press ds-model 1
                     (par-pos u v)
                     gain) ))

(define (f5)                 ; f5 = add 5 pt_load near middle
  (list (pp .5 .5) (pp .4 .4)
        (pp .4 .6) (pp .6 .4) (pp .6 .6) ))

(define (af gain)            ; af = add to all pt load gains
  (ds:set-load-gain ds-model -2 gain #t) )

(define (sf gain)            ; sf = set all pt load gains
  (ds:set-load-gain ds-model -2 gain) )

(define (spr u v . opt)      ; spr = add spring load
  (let ((gain (if (not (null? opt)) (car opt) 500)))
    (ds:add-spring ds-model 1 (par-pos u v) gain) ))

;(define (slider u v . opt)   ; slider = add slider spring load
;  (let ((gain (if (not (null? opt)) (car opt) 500)))
;    (ds:add-spring ds-model 1 (par-pos u v) gain 1) ))

(define (asf gain)           ; asf = add to all spring load gains
  (ds:set-load-gain ds-model -3 gain #t) )

(define (ssf gain)           ; ssf = set all spring load gains
  (ds:set-load-gain ds-model -3 gain) )

(define (dp . opt)           ; dp . gain u0 v0 u1 v1 = add distributed pressure
  (let ( (gain (if (not (null? opt)) (car opt) 500))
         (pos  (if (not (null? opt)) (cdr opt) opt))
         )
    (cond ((or (null? opt) (null? pos))
           (set! ds-pressure
                 (ds:add-dist-press ds-model 1 gain)))
          ((null? (cdr pos))
           (display "wrong number of args \n")
           (display "syntax: dp [gain(500) [u0 v0 [u1 v1]]] \n")
           (display "effect: add a distributed pressure square\n")
           (set! ds-pressure -1))
          ((null? (cddr pos))
           (set! ds-pressure
                 (ds:add-dist-press ds-model 1 gain
                                    (par-pos (car  pos)
                                             (cadr pos)))))
          ((null? (cdddr pos))
           (display "wrong number of args \n")
           (display "syntax: dp [gain(500) [u0 v0 [u1 v1]]] \n")
           (display "effect: add a distributed pressure square\n")
           (set! ds-pressure -1))
          (else
            (set! ds-pressure
                  (ds:add-dist-press ds-model 1 gain
                                     (par-pos (car pos)
                                              (cadr pos))
                                     (par-pos (caddr pos)
                                              (cadddr pos)) ))))
    (+ 0 ds-pressure) ))

(define (gravity . opt)      ; gravity = add vector load
  (let ((gain (if (not (null? opt)) (car opt) 100)))
    (ds:add-vector-load ds-model 1 gain) ))

(define (attractor . opt)      ; gravity = add vector load
  (let ((gain (if (not (null? opt)) (car opt) 25000))
        (pow  (if (not (or (null? opt) (null? (cdr opt))))
                  (cadr  opt)  2)))
    (ds:add-attractor ds-model 1 pow gain) ))


; cl(uv0 uv1)   = add str curve load from uv0 to uv1
; clz(u z r . g)= add u-param str curve to circle load
; cir-load(u v r. g)= add circ load ctr=u,v rad=r gain=g
; str-load()    = apply a test straight crv_load
; par-load()    = apply a test parabola crv_load(tag=ds-cload1)

(define (cl u1 v1 u2 v2)     ; cl = add crv load constraint
  (ds:add-str-load ds-model 1
                   (par-pos u1 v1)
                   (par-pos u2 v2) 500)
  )

(define (clz u z r . opt)   ; clx = add crv-load circular constraint
  (let ((gain (if (not (null? opt)) (car opt) 300)))
    (ds:add-spring-curve ds-model 1
                         (par-pos u 0)
                         (par-pos u 1)
                         (position 0 0 z)
                         (position r 0 0)
                         (position 0 r 0)
                         gain) ))

(define (cir-load u v r . g)     ; cir-load = add circ load
  ;    ctr=u,c rad=r gain=g
  (cond ((null? g)
         (ds:add-circ-load ds-model 1
                           (par-pos u v)
                           (par-pos r 0)
                           (par-pos 0 r) 200))
        (else
          (ds:add-circ-load ds-model 1
                            (par-pos u v)
                            (par-pos r 0)
                            (par-pos 0 r) (car g)))
        ))

(define (par-load)           ; par-load = apply a test parabola crv_load
  (set! ds-cload1
        (ds:add-parab-load ds-model 1
                           (par-pos 0.3 1.0)
                           (par-pos 1.0 1.0)
                           (par-pos 1.0 0.3) 100)))

;; execute the one time only startup sequence
;;    open a renderware window
;;    defines a test ds-model and a family
;;    of global varaibles used to share data
;;    between these scheme functions

;;============================================================
;; Define symbols used in the demo sequences - just one time
;;============================================================

(require 'DSdemoinit  "demoinit.scm")


